home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / kolekce / d6 / rxlibsetup.exe / {app} / units / rxStrUtils.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-02-19  |  28.0 KB  |  1,064 lines

  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 2001,2002 SGB Software          }
  6. {         Copyright (c) 1997, 1998 Fedor Koshevnikov,   }
  7. {                        Igor Pavluk and Serge Korolev  }
  8. {                                                       }
  9. {         This unit based on AlexGraf String Library    }
  10. {         by Alexei Lukin (c) 1992                      }
  11. {                                                       }
  12. {*******************************************************}
  13.  
  14. unit rxStrUtils;
  15.  
  16. {$I RX.INC}
  17. {$A+,B-,E-,R-}
  18.  
  19. interface
  20.  
  21. uses SysUtils;
  22.  
  23. type
  24. {$IFNDEF RX_D4}
  25.   TSysCharSet = set of Char;
  26. {$ENDIF}
  27.   TCharSet = TSysCharSet;
  28.  
  29. { ** Common string handling routines ** }
  30.  
  31. function StrToOem(const AnsiStr: string): string;
  32. { StrToOem translates a string from the Windows character set into the
  33.   OEM character set. }
  34.  
  35. function OemToAnsiStr(const OemStr: string): string;
  36. { OemToAnsiStr translates a string from the OEM character set into the
  37.   Windows character set. }
  38.  
  39. function IsEmptyStr(const S: string; const EmptyChars: TCharSet): Boolean;
  40. { EmptyStr returns true if the given string contains only character
  41.   from the EmptyChars. }
  42.  
  43. function ReplaceStr(const S, Srch, Replace: string): string;
  44. { Returns string with every occurrence of Srch string replaced with
  45.   Replace string. }
  46.  
  47. function DelSpace(const S: string): string;
  48. { DelSpace return a string with all white spaces removed. }
  49.  
  50. function DelChars(const S: string; Chr: Char): string;
  51. { DelChars return a string with all Chr characters removed. }
  52.  
  53. function DelBSpace(const S: string): string;
  54. { DelBSpace trims leading spaces from the given string. }
  55.  
  56. function DelESpace(const S: string): string;
  57. { DelESpace trims trailing spaces from the given string. }
  58.  
  59. function DelRSpace(const S: string): string;
  60. { DelRSpace trims leading and trailing spaces from the given string. }
  61.  
  62. function DelSpace1(const S: string): string;
  63. { DelSpace1 return a string with all non-single white spaces removed. }
  64.  
  65. function Tab2Space(const S: string; Numb: Byte): string;
  66. { Tab2Space converts any tabulation character in the given string to the
  67.   Numb spaces characters. }
  68.  
  69. function NPos(const C: string; S: string; N: Integer): Integer;
  70. { NPos searches for a N-th position of substring C in a given string. }
  71.  
  72. function MakeStr(C: Char; N: Integer): string;
  73. function MS(C: Char; N: Integer): string;
  74. { MakeStr return a string of length N filled with character C. }
  75.  
  76. function AddChar(C: Char; const S: string; N: Integer): string;
  77. { AddChar return a string left-padded to length N with characters C. }
  78.  
  79. function AddCharR(C: Char; const S: string; N: Integer): string;
  80. { AddCharR return a string right-padded to length N with characters C. }
  81.  
  82. function LeftStr(const S: string; N: Integer): string;
  83. { LeftStr return a string right-padded to length N with blanks. }
  84.  
  85. function RightStr(const S: string; N: Integer): string;
  86. { RightStr return a string left-padded to length N with blanks. }
  87.  
  88. function CenterStr(const S: string; Len: Integer): string;
  89. { CenterStr centers the characters in the string based upon the
  90.   Len specified. }
  91.  
  92. function CompStr(const S1, S2: string): Integer;
  93. { CompStr compares S1 to S2, with case-sensitivity. The return value is
  94.   -1 if S1 < S2, 0 if S1 = S2, or 1 if S1 > S2. }
  95.  
  96. function CompText(const S1, S2: string): Integer;
  97. { CompText compares S1 to S2, without case-sensitivity. The return value
  98.   is the same as for CompStr. }
  99.  
  100. function Copy2Symb(const S: string; Symb: Char): string;
  101. { Copy2Symb returns a substring of a string S from begining to first
  102.   character Symb. }
  103.  
  104. function Copy2SymbDel(var S: string; Symb: Char): string;
  105. { Copy2SymbDel returns a substring of a string S from begining to first
  106.   character Symb and removes this substring from S. }
  107.  
  108. function Copy2Space(const S: string): string;
  109. { Copy2Symb returns a substring of a string S from begining to first
  110.   white space. }
  111.  
  112. function Copy2SpaceDel(var S: string): string;
  113. { Copy2SpaceDel returns a substring of a string S from begining to first
  114.   white space and removes this substring from S. }
  115.  
  116. function AnsiProperCase(const S: string; const WordDelims: TCharSet): string;
  117. { Returns string, with the first letter of each word in uppercase,
  118.   all other letters in lowercase. Words are delimited by WordDelims. }
  119.  
  120. function WordCount(const S: string; const WordDelims: TCharSet): Integer;
  121. { WordCount given a set of word delimiters, returns number of words in S. }
  122.  
  123. function WordPosition(const N: Integer; const S: string;
  124.   const WordDelims: TCharSet): Integer;
  125. { Given a set of word delimiters, returns start position of N'th word in S. }
  126.  
  127. function ExtractWord(N: Integer; const S: string;
  128.   const WordDelims: TCharSet): string;
  129. function ExtractWordPos(N: Integer; const S: string;
  130.   const WordDelims: TCharSet; var Pos: Integer): string;
  131. function ExtractDelimited(N: Integer; const S: string;
  132.   const Delims: TCharSet): string;
  133. { ExtractWord, ExtractWordPos and ExtractDelimited given a set of word
  134.   delimiters, return the N'th word in S. }
  135.  
  136. function ExtractSubstr(const S: string; var Pos: Integer;
  137.   const Delims: TCharSet): string;
  138. { ExtractSubstr given a set of word delimiters, returns the substring from S,
  139.   that started from position Pos. }
  140.  
  141. function IsWordPresent(const W, S: string; const WordDelims: TCharSet): Boolean;
  142. { IsWordPresent given a set of word delimiters, returns True if word W is
  143.   present in string S. }
  144.  
  145. function QuotedString(const S: string; Quote: Char): string;
  146. { QuotedString returns the given string as a quoted string, using the
  147.   provided Quote character. }
  148.  
  149. function ExtractQuotedString(const S: string; Quote: Char): string;
  150. { ExtractQuotedString removes the Quote characters from the beginning and
  151.   end of a quoted string, and reduces pairs of Quote characters within
  152.   the quoted string to a single character. }
  153.  
  154. function FindPart(const HelpWilds, InputStr: string): Integer;
  155. { FindPart compares a string with '?' and another, returns the position of
  156.   HelpWilds in InputStr. }
  157.  
  158. function IsWild(InputStr, Wilds: string; IgnoreCase: Boolean): Boolean;
  159. { IsWild compares InputString with WildCard string and returns True
  160.   if corresponds. }
  161.  
  162. function XorString(const Key, Src: ShortString): ShortString;
  163. function XorEncode(const Key, Source: string): string;
  164. function XorDecode(const Key, Source: string): string;
  165.  
  166. { ** Command line routines ** }
  167.  
  168. {$IFNDEF RX_D4}
  169. function FindCmdLineSwitch(const Switch: string; SwitchChars: TCharSet;
  170.   IgnoreCase: Boolean): Boolean;
  171. {$ENDIF}
  172. function GetCmdLineArg(const Switch: string; SwitchChars: TCharSet): string;
  173.  
  174. { ** Numeric string handling routines ** }
  175.  
  176. function Numb2USA(const S: string): string;
  177. { Numb2USA converts numeric string S to USA-format. }
  178.  
  179. function Dec2Hex(N: Longint; A: Byte): string;
  180. function D2H(N: Longint; A: Byte): string;
  181. { Dec2Hex converts the given value to a hexadecimal string representation
  182.   with the minimum number of digits (A) specified. }
  183.  
  184. function Hex2Dec(const S: string): Longint;
  185. function H2D(const S: string): Longint;
  186. { Hex2Dec converts the given hexadecimal string to the corresponding integer
  187.   value. }
  188.  
  189. function Dec2Numb(N: Longint; A, B: Byte): string;
  190. { Dec2Numb converts the given value to a string representation with the
  191.   base equal to B and with the minimum number of digits (A) specified. }
  192.  
  193. function Numb2Dec(S: string; B: Byte): Longint;
  194. { Numb2Dec converts the given B-based numeric string to the corresponding
  195.   integer value. }
  196.  
  197. function IntToBin(Value: Longint; Digits, Spaces: Integer): string;
  198. { IntToBin converts the given value to a binary string representation
  199.   with the minimum number of digits specified. }
  200.  
  201. function IntToRoman(Value: Longint): string;
  202. { IntToRoman converts the given value to a roman numeric string
  203.   representation. }
  204.  
  205. function RomanToInt(const S: string): Longint;
  206. { RomanToInt converts the given string to an integer value. If the string
  207.   doesn't contain a valid roman numeric value, the 0 value is returned. }
  208.  
  209. const
  210.   CRLF = #13#10;
  211.   DigitChars = ['0'..'9'];
  212. {$IFNDEF CBUILDER}
  213.   Brackets = ['(',')','[',']','{','}'];
  214.   StdWordDelims = [#0..' ',',','.',';','/','\',':','''','"','`'] + Brackets;
  215. {$ENDIF}
  216.  
  217. implementation
  218.  
  219. uses {$IFDEF WIN32} Windows {$ELSE} WinTypes, WinProcs {$ENDIF};
  220.  
  221. function StrToOem(const AnsiStr: string): string;
  222. begin
  223.   SetLength(Result, Length(AnsiStr));
  224.   if Length(Result) > 0 then
  225. {$IFDEF WIN32}
  226.     CharToOemBuff(PChar(AnsiStr), PChar(Result), Length(Result));
  227. {$ELSE}
  228.     AnsiToOemBuff(@AnsiStr[1], @Result[1], Length(Result));
  229. {$ENDIF}
  230. end;
  231.  
  232. function OemToAnsiStr(const OemStr: string): string;
  233. begin
  234.   SetLength(Result, Length(OemStr));
  235.   if Length(Result) > 0 then
  236. {$IFDEF WIN32}
  237.     OemToCharBuff(PChar(OemStr), PChar(Result), Length(Result));
  238. {$ELSE}
  239.     OemToAnsiBuff(@OemStr[1], @Result[1], Length(Result));
  240. {$ENDIF}
  241. end;
  242.  
  243. function IsEmptyStr(const S: string; const EmptyChars: TCharSet): Boolean;
  244. var
  245.   I, SLen: Integer;
  246. begin
  247.   SLen := Length(S);
  248.   I := 1;
  249.   while I <= SLen do begin
  250.     if not (S[I] in EmptyChars) then begin
  251.       Result := False;
  252.       Exit;
  253.     end
  254.     else Inc(I);
  255.   end;
  256.   Result := True;
  257. end;
  258.  
  259. function ReplaceStr(const S, Srch, Replace: string): string;
  260. var
  261.   I: Integer;
  262.   Source: string;
  263. begin
  264.   Source := S;
  265.   Result := '';
  266.   repeat
  267.     I := Pos(Srch, Source);
  268.     if I > 0 then begin
  269.       Result := Result + Copy(Source, 1, I - 1) + Replace;
  270.       Source := Copy(Source, I + Length(Srch), MaxInt);
  271.     end
  272.     else Result := Result + Source;
  273.   until I <= 0;
  274. end;
  275.  
  276. function DelSpace(const S: String): string;
  277. begin
  278.   Result := DelChars(S, ' ');
  279. end;
  280.  
  281. function DelChars(const S: string; Chr: Char): string;
  282. var
  283.   I: Integer;
  284. begin
  285.   Result := S;
  286.   for I := Length(Result) downto 1 do begin
  287.     if Result[I] = Chr then Delete(Result, I, 1);
  288.   end;
  289. end;
  290.  
  291. function DelBSpace(const S: string): string;
  292. var
  293.   I, L: Integer;
  294. begin
  295.   L := Length(S);
  296.   I := 1;
  297.   while (I <= L) and (S[I] = ' ') do Inc(I);
  298.   Result := Copy(S, I, MaxInt);
  299. end;
  300.  
  301. function DelESpace(const S: string): string;
  302. var
  303.   I: Integer;
  304. begin
  305.   I := Length(S);
  306.   while (I > 0) and (S[I] = ' ') do Dec(I);
  307.   Result := Copy(S, 1, I);
  308. end;
  309.  
  310. function DelRSpace(const S: string): string;
  311. begin
  312.   Result := DelBSpace(DelESpace(S));
  313. end;
  314.  
  315. function DelSpace1(const S: string): string;
  316. var
  317.   I: Integer;
  318. begin
  319.   Result := S;
  320.   for I := Length(Result) downto 2 do begin
  321.     if (Result[I] = ' ') and (Result[I - 1] = ' ') then
  322.       Delete(Result, I, 1);
  323.   end;
  324. end;
  325.  
  326. function Tab2Space(const S: string; Numb: Byte): string;
  327. var
  328.   I: Integer;
  329. begin
  330.   I := 1;
  331.   Result := S;
  332.   while I <= Length(Result) do begin
  333.     if Result[I] = Chr(9) then begin
  334.       Delete(Result, I, 1);
  335.       Insert(MakeStr(' ', Numb), Result, I);
  336.       Inc(I, Numb);
  337.     end
  338.     else Inc(I);
  339.   end;
  340. end;
  341.  
  342. function MakeStr(C: Char; N: Integer): string;
  343. begin
  344.   if N < 1 then Result := ''
  345.   else begin
  346. {$IFNDEF WIN32}
  347.     if N > 255 then N := 255;
  348. {$ENDIF WIN32}
  349.     SetLength(Result, N);
  350.     FillChar(Result[1], Length(Result), C);
  351.   end;
  352. end;
  353.  
  354. function MS(C: Char; N: Integer): string;
  355. begin
  356.   Result := MakeStr(C, N);
  357. end;
  358.  
  359. function NPos(const C: string; S: string; N: Integer): Integer;
  360. var
  361.   I, P, K: Integer;
  362. begin
  363.   Result := 0;
  364.   K := 0;
  365.   for I := 1 to N do begin
  366.     P := Pos(C, S);
  367.     Inc(K, P);
  368.     if (I = N) and (P > 0) then begin
  369.       Result := K;
  370.       Exit;
  371.     end;
  372.     if P > 0 then Delete(S, 1, P)
  373.     else Exit;
  374.   end;
  375. end;
  376.  
  377. function AddChar(C: Char; const S: string; N: Integer): string;
  378. begin
  379.   if Length(S) < N then
  380.     Result := MakeStr(C, N - Length(S)) + S
  381.   else Result := S;
  382. end;
  383.  
  384. function AddCharR(C: Char; const S: string; N: Integer): string;
  385. begin
  386.   if Length(S) < N then
  387.     Result := S + MakeStr(C, N - Length(S))
  388.   else Result := S;
  389. end;
  390.  
  391. function LeftStr(const S: string; N: Integer): string;
  392. begin
  393.   Result := AddCharR(' ', S, N);
  394. end;
  395.  
  396. function RightStr(const S: string; N: Integer): string;
  397. begin
  398.   Result := AddChar(' ', S, N);
  399. end;
  400.  
  401. function CompStr(const S1, S2: string): Integer;
  402. begin
  403. {$IFDEF WIN32}
  404.   Result := CompareString(GetThreadLocale, SORT_STRINGSORT, PChar(S1),
  405.     Length(S1), PChar(S2), Length(S2)) - 2;
  406. {$ELSE}
  407.   Result := CompareStr(S1, S2);
  408. {$ENDIF}
  409. end;
  410.  
  411. function CompText(const S1, S2: string): Integer;
  412. begin
  413. {$IFDEF WIN32}
  414.   Result := CompareString(GetThreadLocale, SORT_STRINGSORT or NORM_IGNORECASE,
  415.     PChar(S1), Length(S1), PChar(S2), Length(S2)) - 2;
  416. {$ELSE}
  417.   Result := CompareText(S1, S2);
  418. {$ENDIF}
  419. end;
  420.  
  421. function Copy2Symb(const S: string; Symb: Char): string;
  422. var
  423.   P: Integer;
  424. begin
  425.   P := Pos(Symb, S);
  426.   if P = 0 then P := Length(S) + 1;
  427.   Result := Copy(S, 1, P - 1);
  428. end;
  429.  
  430. function Copy2SymbDel(var S: string; Symb: Char): string;
  431. begin
  432.   Result := Copy2Symb(S, Symb);
  433.   S := DelBSpace(Copy(S, Length(Result) + 1, Length(S)));
  434. end;
  435.  
  436. function Copy2Space(const S: string): string;
  437. begin
  438.   Result := Copy2Symb(S, ' ');
  439. end;
  440.  
  441. function Copy2SpaceDel(var S: string): string;
  442. begin
  443.   Result := Copy2SymbDel(S, ' ');
  444. end;
  445.  
  446. function AnsiProperCase(const S: string; const WordDelims: TCharSet): string;
  447. var
  448.   SLen, I: Cardinal;
  449. begin
  450.   Result := AnsiLowerCase(S);
  451.   I := 1;
  452.   SLen := Length(Result);
  453.   while I <= SLen do begin
  454.     while (I <= SLen) and (Result[I] in WordDelims) do Inc(I);
  455.     if I <= SLen then Result[I] := AnsiUpperCase(Result[I])[1];
  456.     while (I <= SLen) and not (Result[I] in WordDelims) do Inc(I);
  457.   end;
  458. end;
  459.  
  460. function WordCount(const S: string; const WordDelims: TCharSet): Integer;
  461. var
  462.   SLen, I: Cardinal;
  463. begin
  464.   Result := 0;
  465.   I := 1;
  466.   SLen := Length(S);
  467.   while I <= SLen do begin
  468.     while (I <= SLen) and (S[I] in WordDelims) do Inc(I);
  469.     if I <= SLen then Inc(Result);
  470.     while (I <= SLen) and not(S[I] in WordDelims) do Inc(I);
  471.   end;
  472. end;
  473.  
  474. function WordPosition(const N: Integer; const S: string;
  475.   const WordDelims: TCharSet): Integer;
  476. var
  477.   Count, I: Integer;
  478. begin
  479.   Count := 0;
  480.   I := 1;
  481.   Result := 0;
  482.   while (I <= Length(S)) and (Count <> N) do begin
  483.     { skip over delimiters }
  484.     while (I <= Length(S)) and (S[I] in WordDelims) do Inc(I);
  485.     { if we're not beyond end of S, we're at the start of a word }
  486.     if I <= Length(S) then Inc(Count);
  487.     { if not finished, find the end of the current word }
  488.     if Count <> N then
  489.       while (I <= Length(S)) and not (S[I] in WordDelims) do Inc(I)
  490.     else Result := I;
  491.   end;
  492. end;
  493.  
  494. function ExtractWord(N: Integer; const S: string;
  495.   const WordDelims: TCharSet): string;
  496. var
  497.   I: Integer;
  498.   Len: Integer;
  499. begin
  500.   Len := 0;
  501.   I := WordPosition(N, S, WordDelims);
  502.   if I <> 0 then
  503.     { find the end of the current word }
  504.     while (I <= Length(S)) and not(S[I] in WordDelims) do begin
  505.       { add the I'th character to result }
  506.       Inc(Len);
  507.       SetLength(Result, Len);
  508.       Result[Len] := S[I];
  509.       Inc(I);
  510.     end;
  511.   SetLength(Result, Len);
  512. end;
  513.  
  514. function ExtractWordPos(N: Integer; const S: string;
  515.   const WordDelims: TCharSet; var Pos: Integer): string;
  516. var
  517.   I, Len: Integer;
  518. begin
  519.   Len := 0;
  520.   I := WordPosition(N, S, WordDelims);
  521.   Pos := I;
  522.   if I <> 0 then
  523.     { find the end of the current word }
  524.     while (I <= Length(S)) and not(S[I] in WordDelims) do begin
  525.       { add the I'th character to result }
  526.       Inc(Len);
  527.       SetLength(Result, Len);
  528.       Result[Len] := S[I];
  529.       Inc(I);
  530.     end;
  531.   SetLength(Result, Len);
  532. end;
  533.  
  534. function ExtractDelimited(N: Integer; const S: string;
  535.   const Delims: TCharSet): string;
  536. var
  537.   CurWord: Integer;
  538.   I, Len, SLen: Integer;
  539. begin
  540.   CurWord := 0;
  541.   I := 1;
  542.   Len := 0;
  543.   SLen := Length(S);
  544.   SetLength(Result, 0);
  545.   while (I <= SLen) and (CurWord <> N) do begin
  546.     if S[I] in Delims then Inc(CurWord)
  547.     else begin
  548.       if CurWord = N - 1 then begin
  549.         Inc(Len);
  550.         SetLength(Result, Len);
  551.         Result[Len] := S[I];
  552.       end;
  553.     end;
  554.     Inc(I);
  555.   end;
  556. end;
  557.  
  558. function ExtractSubstr(const S: string; var Pos: Integer;
  559.   const Delims: TCharSet): string;
  560. var
  561.   I: Integer;
  562. begin
  563.   I := Pos;
  564.   while (I <= Length(S)) and not (S[I] in Delims) do Inc(I);
  565.   Result := Copy(S, Pos, I - Pos);
  566.   if (I <= Length(S)) and (S[I] in Delims) then Inc(I);
  567.   Pos := I;
  568. end;
  569.  
  570. function IsWordPresent(const W, S: string; const WordDelims: TCharSet): Boolean;
  571. var
  572.   Count, I: Integer;
  573. begin
  574.   Result := False;
  575.   Count := WordCount(S, WordDelims);
  576.   for I := 1 to Count do
  577.     if ExtractWord(I, S, WordDelims) = W then begin
  578.       Result := True;
  579.       Exit;
  580.     end;
  581. end;
  582.  
  583. {$IFDEF WIN32}
  584.   {$IFNDEF VER90}
  585.     { C++Builder or Delphi 3.0 }
  586.     {$DEFINE MBCS}
  587.   {$ENDIF}
  588. {$ENDIF}
  589.  
  590. function QuotedString(const S: string; Quote: Char): string;
  591. {$IFDEF MBCS}
  592. begin
  593.   Result := AnsiQuotedStr(S, Quote);
  594. {$ELSE}
  595. var
  596.   I: Integer;
  597. begin
  598.   Result := S;
  599.   for I := Length(Result) downto 1 do
  600.     if Result[I] = Quote then Insert(Quote, Result, I);
  601.   Result := Quote + Result + Quote;
  602. {$ENDIF MBCS}
  603. end;
  604.  
  605. function ExtractQuotedString(const S: string; Quote: Char): string;
  606. var
  607. {$IFDEF MBCS}
  608.   P: PChar;
  609. begin
  610.   P := PChar(S);
  611.   if P^ = Quote then Result := AnsiExtractQuotedStr(P, Quote)
  612.   else Result := S;
  613. {$ELSE}
  614.   I: Integer;
  615. begin
  616.   Result := S;
  617.   I := Length(Result);
  618.   if (I > 0) and (Result[1] = Quote) and
  619.     (Result[I] = Quote) then
  620.   begin
  621.     Delete(Result, I, 1);
  622.     Delete(Result, 1, 1);
  623.     for I := Length(Result) downto 2 do begin
  624.       if (Result[I] = Quote) and (Result[I - 1] = Quote) then
  625.         Delete(Result, I, 1);
  626.     end;
  627.   end;
  628. {$ENDIF MBCS}
  629. end;
  630.  
  631. function Numb2USA(const S: string): string;
  632. var
  633.   I, NA: Integer;
  634. begin
  635.   I := Length(S);
  636.   Result := S;
  637.   NA := 0;
  638.   while (I > 0) do begin
  639.     if ((Length(Result) - I + 1 - NA) mod 3 = 0) and (I <> 1) then
  640.     begin
  641.       Insert(',', Result, I);
  642.       Inc(NA);
  643.     end;
  644.     Dec(I);
  645.   end;
  646. end;
  647.  
  648. function CenterStr(const S: string; Len: Integer): string;
  649. begin
  650.   if Length(S) < Len then begin
  651.     Result := MakeStr(' ', (Len div 2) - (Length(S) div 2)) + S;
  652.     Result := Result + MakeStr(' ', Len - Length(Result));
  653.   end
  654.   else Result := S;
  655. end;
  656.  
  657. function Dec2Hex(N: LongInt; A: Byte): string;
  658. begin
  659.   Result := IntToHex(N, A);
  660. end;
  661.  
  662. function D2H(N: LongInt; A: Byte): string;
  663. begin
  664.   Result := IntToHex(N, A);
  665. end;
  666.  
  667. function Hex2Dec(const S: string): Longint;
  668. var
  669.   HexStr: string;
  670. begin
  671.   if Pos('$', S) = 0 then HexStr := '$' + S
  672.   else HexStr := S;
  673.   Result := StrToIntDef(HexStr, 0);
  674. end;
  675.  
  676. function H2D(const S: string): Longint;
  677. begin
  678.   Result := Hex2Dec(S);
  679. end;
  680.  
  681. function Dec2Numb(N: Longint; A, B: Byte): string;
  682. var
  683.   C: Integer;
  684. {$IFDEF RX_D4}
  685.   Number: Cardinal;
  686. {$ELSE}
  687.   Number: Longint;
  688. {$ENDIF}
  689. begin
  690.   if N = 0 then Result := '0'
  691.   else begin
  692. {$IFDEF RX_D4}
  693.     Number := Cardinal(N);
  694. {$ELSE}
  695.     Number := N;
  696. {$ENDIF}
  697.     Result := '';
  698.     while Number > 0 do begin
  699.       C := Number mod B;
  700.       if C > 9 then C := C + 55
  701.       else C := C + 48;
  702.       Result := Chr(C) + Result;
  703.       Number := Number div B;
  704.     end;
  705.   end;
  706.   if Result <> '' then Result := AddChar('0', Result, A);
  707. end;
  708.  
  709. function Numb2Dec(S: string; B: Byte): Longint;
  710. var
  711.   I, P: Longint;
  712. begin
  713.   I := Length(S);
  714.   Result := 0;
  715.   S := UpperCase(S);
  716.   P := 1;
  717.   while (I >= 1) do begin
  718.     if S[I] > '@' then Result := Result + (Ord(S[I]) - 55) * P
  719.     else Result := Result + (Ord(S[I]) - 48) * P;
  720.     Dec(I);
  721.     P := P * B;
  722.   end;
  723. end;
  724.  
  725. function RomanToInt(const S: string): Longint;
  726. const
  727.   RomanChars = ['C','D','I','L','M','V','X'];
  728.   RomanValues: array['C'..'X'] of Word =
  729.     (100,500,0,0,0,0,1,0,0,50,1000,0,0,0,0,0,0,0,0,5,0,10);
  730. var
  731.   Index, Next: Char;
  732.   I: Integer;
  733.   Negative: Boolean;
  734. begin
  735.   Result := 0;
  736.   I := 0;
  737.   Negative := (Length(S) > 0) and (S[1] = '-');
  738.   if Negative then Inc(I);
  739.   while (I < Length(S)) do begin
  740.     Inc(I);
  741.     Index := UpCase(S[I]);
  742.     if Index in RomanChars then begin
  743.       if Succ(I) <= Length(S) then Next := UpCase(S[I + 1])
  744.       else Next := #0;
  745.       if (Next in RomanChars) and (RomanValues[Index] < RomanValues[Next]) then
  746.       begin
  747.         Inc(Result, RomanValues[Next]);
  748.         Dec(Result, RomanValues[Index]);
  749.         Inc(I);
  750.       end
  751.       else Inc(Result, RomanValues[Index]);
  752.     end
  753.     else begin
  754.       Result := 0;
  755.       Exit;
  756.     end;
  757.   end;
  758.   if Negative then Result := -Result;
  759. end;
  760.  
  761. function IntToRoman(Value: Longint): string;
  762. Label
  763.   A500, A400, A100, A90, A50, A40, A10, A9, A5, A4, A1;
  764. begin
  765.   Result := '';
  766. {$IFNDEF WIN32}
  767.   if (Value > MaxInt * 2) then Exit;
  768. {$ENDIF}
  769.   while Value >= 1000 do begin
  770.     Dec(Value, 1000); Result := Result + 'M';
  771.   end;
  772.   if Value < 900 then goto A500
  773.   else begin
  774.     Dec(Value, 900); Result := Result + 'CM';
  775.   end;
  776.   goto A90;
  777. A400:
  778.   if Value < 400 then goto A100
  779.   else begin
  780.     Dec(Value, 400); Result := Result + 'CD';
  781.   end;
  782.   goto A90;
  783. A500:
  784.   if Value < 500 then goto A400
  785.   else begin
  786.     Dec(Value, 500); Result := Result + 'D';
  787.   end;
  788. A100:
  789.   while Value >= 100 do begin
  790.     Dec(Value, 100); Result := Result + 'C';
  791.   end;
  792. A90:
  793.   if Value < 90 then goto A50
  794.   else begin
  795.     Dec(Value, 90); Result := Result + 'XC';
  796.   end;
  797.   goto A9;
  798. A40:
  799.   if Value < 40 then goto A10
  800.   else begin
  801.     Dec(Value, 40); Result := Result + 'XL';
  802.   end;
  803.   goto A9;
  804. A50:
  805.   if Value < 50 then goto A40
  806.   else begin
  807.     Dec(Value, 50); Result := Result + 'L';
  808.   end;
  809. A10:
  810.   while Value >= 10 do begin
  811.     Dec(Value, 10); Result := Result + 'X';
  812.   end;
  813. A9:
  814.   if Value < 9 then goto A5
  815.   else begin
  816.     Result := Result + 'IX';
  817.   end;
  818.   Exit;
  819. A4:
  820.   if Value < 4 then goto A1
  821.   else begin
  822.     Result := Result + 'IV';
  823.   end;
  824.   Exit;
  825. A5:
  826.   if Value < 5 then goto A4
  827.   else begin
  828.     Dec(Value, 5); Result := Result + 'V';
  829.   end;
  830.   goto A1;
  831. A1:
  832.   while Value >= 1 do begin
  833.     Dec(Value); Result := Result + 'I';
  834.   end;
  835. end;
  836.  
  837. function IntToBin(Value: Longint; Digits, Spaces: Integer): string;
  838. begin
  839.   Result := '';
  840.   if Digits > 32 then Digits := 32;
  841.   while Digits > 0 do begin
  842.     if (Digits mod Spaces) = 0 then Result := Result + ' ';
  843.     Dec(Digits);
  844.     Result := Result + IntToStr((Value shr Digits) and 1);
  845.   end;
  846. end;
  847.  
  848. function FindPart(const HelpWilds, InputStr: string): Integer;
  849. var
  850.   I, J: Integer;
  851.   Diff: Integer;
  852. begin
  853.   I := Pos('?', HelpWilds);
  854.   if I = 0 then begin
  855.     { if no '?' in HelpWilds }
  856.     Result := Pos(HelpWilds, InputStr);
  857.     Exit;
  858.   end;
  859.   { '?' in HelpWilds }
  860.   Diff := Length(InputStr) - Length(HelpWilds);
  861.   if Diff < 0 then begin
  862.     Result := 0;
  863.     Exit;
  864.   end;
  865.   { now move HelpWilds over InputStr }
  866.   for I := 0 to Diff do begin
  867.     for J := 1 to Length(HelpWilds) do begin
  868.       if (InputStr[I + J] = HelpWilds[J]) or
  869.         (HelpWilds[J] = '?') then
  870.       begin
  871.         if J = Length(HelpWilds) then begin
  872.           Result := I + 1;
  873.           Exit;
  874.         end;
  875.       end
  876.       else Break;
  877.     end;
  878.   end;
  879.   Result := 0;
  880. end;
  881.  
  882. function IsWild(InputStr, Wilds: string; IgnoreCase: Boolean): Boolean;
  883.  
  884.  function SearchNext(var Wilds: string): Integer;
  885.  { looking for next *, returns position and string until position }
  886.  begin
  887.    Result := Pos('*', Wilds);
  888.    if Result > 0 then Wilds := Copy(Wilds, 1, Result - 1);
  889.  end;
  890.  
  891. var
  892.   CWild, CInputWord: Integer; { counter for positions }
  893.   I, LenHelpWilds: Integer;
  894.   MaxInputWord, MaxWilds: Integer; { Length of InputStr and Wilds }
  895.   HelpWilds: string;
  896. begin
  897.   if Wilds = InputStr then begin
  898.     Result := True;
  899.     Exit;
  900.   end;
  901.   repeat { delete '**', because '**' = '*' }
  902.     I := Pos('**', Wilds);
  903.     if I > 0 then
  904.       Wilds := Copy(Wilds, 1, I - 1) + '*' + Copy(Wilds, I + 2, MaxInt);
  905.   until I = 0;
  906.   if Wilds = '*' then begin { for fast end, if Wilds only '*' }
  907.     Result := True;
  908.     Exit;
  909.   end;
  910.   MaxInputWord := Length(InputStr);
  911.   MaxWilds := Length(Wilds);
  912.   if IgnoreCase then begin { upcase all letters }
  913.     InputStr := AnsiUpperCase(InputStr);
  914.     Wilds := AnsiUpperCase(Wilds);
  915.   end;
  916.   if (MaxWilds = 0) or (MaxInputWord = 0) then begin
  917.     Result := False;
  918.     Exit;
  919.   end;
  920.   CInputWord := 1;
  921.   CWild := 1;
  922.   Result := True;
  923.   repeat
  924.     if InputStr[CInputWord] = Wilds[CWild] then begin { equal letters }
  925.       { goto next letter }
  926.       Inc(CWild);
  927.       Inc(CInputWord);
  928.       Continue;
  929.     end;
  930.     if Wilds[CWild] = '?' then begin { equal to '?' }
  931.       { goto next letter }
  932.       Inc(CWild);
  933.       Inc(CInputWord);
  934.       Continue;
  935.     end;
  936.     if Wilds[CWild] = '*' then begin { handling of '*' }
  937.       HelpWilds := Copy(Wilds, CWild + 1, MaxWilds);
  938.       I := SearchNext(HelpWilds);
  939.       LenHelpWilds := Length(HelpWilds);
  940.       if I = 0 then begin
  941.         { no '*' in the rest, compare the ends }
  942.         if HelpWilds = '' then Exit; { '*' is the last letter }
  943.         { check the rest for equal Length and no '?' }
  944.         for I := 0 to LenHelpWilds - 1 do begin
  945.           if (HelpWilds[LenHelpWilds - I] <> InputStr[MaxInputWord - I]) and
  946.             (HelpWilds[LenHelpWilds - I]<> '?') then
  947.           begin
  948.             Result := False;
  949.             Exit;
  950.           end;
  951.         end;
  952.         Exit;
  953.       end;
  954.       { handle all to the next '*' }
  955.       Inc(CWild, 1 + LenHelpWilds);
  956.       I := FindPart(HelpWilds, Copy(InputStr, CInputWord, MaxInt));
  957.       if I= 0 then begin
  958.         Result := False;
  959.         Exit;
  960.       end;
  961.       CInputWord := I + LenHelpWilds;
  962.       Continue;
  963.     end;
  964.     Result := False;
  965.     Exit;
  966.   until (CInputWord > MaxInputWord) or (CWild > MaxWilds);
  967.   { no completed evaluation }
  968.   if CInputWord <= MaxInputWord then Result := False;
  969.   if (CWild <= MaxWilds) and (Wilds[MaxWilds] <> '*') then Result := False;
  970. end;
  971.  
  972. function XorString(const Key, Src: ShortString): ShortString;
  973. var
  974.   I: Integer;
  975. begin
  976.   Result := Src;
  977.   if Length(Key) > 0 then
  978.     for I := 1 to Length(Src) do
  979.       Result[I] := Chr(Byte(Key[1 + ((I - 1) mod Length(Key))]) xor Ord(Src[I]));
  980. end;
  981.  
  982. function XorEncode(const Key, Source: string): string;
  983. var
  984.   I: Integer;
  985.   C: Byte;
  986. begin
  987.   Result := '';
  988.   for I := 1 to Length(Source) do begin
  989.     if Length(Key) > 0 then
  990.       C := Byte(Key[1 + ((I - 1) mod Length(Key))]) xor Byte(Source[I])
  991.     else
  992.       C := Byte(Source[I]);
  993.     Result := Result + AnsiLowerCase(IntToHex(C, 2));
  994.   end;
  995. end;
  996.  
  997. function XorDecode(const Key, Source: string): string;
  998. var
  999.   I: Integer;
  1000.   C: Char;
  1001. begin
  1002.   Result := '';
  1003.   for I := 0 to Length(Source) div 2 - 1 do begin
  1004.     C := Chr(StrToIntDef('$' + Copy(Source, (I * 2) + 1, 2), Ord(' ')));
  1005.     if Length(Key) > 0 then
  1006.       C := Chr(Byte(Key[1 + (I mod Length(Key))]) xor Byte(C));
  1007.     Result := Result + C;
  1008.   end;
  1009. end;
  1010.  
  1011. {$IFNDEF RX_D4}
  1012. function FindCmdLineSwitch(const Switch: string; SwitchChars: TCharSet;
  1013.   IgnoreCase: Boolean): Boolean;
  1014. var
  1015.   I: Integer;
  1016.   S: string;
  1017. begin
  1018.   for I := 1 to ParamCount do begin
  1019.     S := ParamStr(I);
  1020.     if (SwitchChars = []) or ((S[1] in SwitchChars) and (Length(S) > 1)) then
  1021.     begin
  1022.       S := Copy(S, 2, MaxInt);
  1023.       if IgnoreCase then begin
  1024.         if (AnsiCompareText(S, Switch) = 0) then begin
  1025.           Result := True;
  1026.           Exit;
  1027.         end;
  1028.       end
  1029.       else begin
  1030.         if (AnsiCompareStr(S, Switch) = 0) then begin
  1031.           Result := True;
  1032.           Exit;
  1033.         end;
  1034.       end;
  1035.     end;
  1036.   end;
  1037.   Result := False;
  1038. end;
  1039. {$ENDIF RX_D4}
  1040.  
  1041. function GetCmdLineArg(const Switch: string; SwitchChars: TCharSet): string;
  1042. var
  1043.   I: Integer;
  1044.   S: string;
  1045. begin
  1046.   I := 1;
  1047.   while I <= ParamCount do begin
  1048.     S := ParamStr(I);
  1049.     if (SwitchChars = []) or ((S[1] in SwitchChars) and (Length(S) > 1)) then
  1050.     begin
  1051.       if (AnsiCompareText(Copy(S, 2, MaxInt), Switch) = 0) then begin
  1052.         Inc(I);
  1053.         if I <= ParamCount then begin
  1054.           Result := ParamStr(I);
  1055.           Exit;
  1056.         end;
  1057.       end;
  1058.     end;
  1059.     Inc(I);
  1060.   end;
  1061.   Result := '';
  1062. end;
  1063.  
  1064. end.